home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-04-11 | 6.0 KB | 187 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- MODULE Kepler4; (* J. Templ, 18.3.91 *)
- IMPORT
- Viewers, KeplerGraphs, KeplerFrames, Oberon, Texts, TextFrames,
- KeplerPorts, Display, Files, Fonts, Kepler2;
- CONST
- ML = 2; MM = 1; MR = 0;
- TYPE
- Icon* = POINTER TO IconDesc;
- IconDesc* = RECORD
- (KeplerFrames.ButtonDesc)
- fnt*: Fonts.Font;
- V: Viewers.Viewer;
- END ;
- Galaxy* = POINTER TO GalaxyDesc;
- GalaxyDesc* = RECORD
- (KeplerGraphs.ConsDesc)
- G*: KeplerGraphs.Graph
- END ;
- (* ---------------------------------- Icon ---------------------------------- *)
- PROCEDURE (I: Icon) Execute* (keys: SET);
- VAR X, Y: INTEGER;
- V, V1: Viewers.Viewer;
- N: Oberon.ControlMsg; msg: Viewers.ViewerMsg;
- BEGIN
- IF keys = {MM} THEN
- IF I.V = NIL THEN
- IF ~Oberon.Pointer.on THEN Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y);
- N.id := Oberon.mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y-1); V.handle(V, N)
- ELSE V := Viewers.This(Oberon.Pointer.X, Oberon.Pointer.Y-1)
- END ;
- I.Execute^({MM});
- V1 := Viewers.This(Oberon.Pointer.X, Oberon.Pointer.Y-1);
- IF V1 # V THEN I.V := V1 END; (* heuristic *)
- ELSIF I.V.state = 0 THEN
- Viewers.Open(I.V, I.V.X, I.V.Y+I.V.H);
- msg.id := Viewers.restore; I.V.handle(I.V, msg)
- END
- ELSIF (keys = {ML, MM}) & (I.cmd #"") THEN
- IF ~Oberon.Pointer.on THEN Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y);
- N.id := Oberon.mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y-1); V.handle(V, N)
- ELSE V := Viewers.This(Oberon.Pointer.X, Oberon.Pointer.Y-1)
- END ;
- I.Execute^({MM});
- V1 := Viewers.This(Oberon.Pointer.X, Oberon.Pointer.Y-1);
- IF V1 # V THEN I.V := V1 END; (* heuristic *)
- ELSE I.Execute^(keys)
- END
- END Execute;
- PROCEDURE (I: Icon) Draw* (F: KeplerPorts.Port);
- BEGIN
- F.DrawRect(I.p[0].x, I.p[0].y, I.p[1].x - I.p[0].x, I.p[1].y - I.p[0].y, Display.white, Display.replace);
- F.DrawString(I.p[0].x + 12, I.p[0].y - I.fnt.minY * 4 + 4, I.par, I.fnt, Display.white, Display.replace)
- END Draw;
- PROCEDURE (I: Icon) Read* (VAR R: Files.Rider);
- VAR fnt: ARRAY 32 OF CHAR;
- BEGIN
- I.Read^(R);
- Files.ReadString(R, fnt);
- I.fnt := Fonts.This(fnt);
- I.V := NIL
- END Read;
- PROCEDURE (I: Icon) Write* (VAR R: Files.Rider);
- BEGIN
- I.Write^(R);
- Files.WriteString(R, I.fnt.name)
- END Write;
- PROCEDURE NewIcon*;
- VAR i: Icon; o: Kepler2.Offset;
- c: KeplerGraphs.Constellation;
- ch: CHAR;
- k, dx, d0, d1, d2, d3: INTEGER;
- d4, beg, end, time: LONGINT;
- R: Texts.Reader;
- S: Texts.Scanner;
- T: Texts.Text;
- BEGIN
- IF KeplerFrames.nofpts >= 1 THEN
- NEW(i); i.nofpts := 2;
- KeplerFrames.ConsumePoint(i.p[0]);
- NEW(o); i.p[1] := o; o.refcnt := 1; NEW(c); o.c := c; c.p[0] := i.p[0]; c.nofpts := 1; INC(c.p[0].refcnt);
- i.V := Oberon.MarkedViewer();
- Texts.OpenReader(R, i.V.dsc(TextFrames.Frame).text, 0);
- Texts.Read(R, ch); i.fnt := R.fnt; k := 0; o.dx := 20;
- WHILE ch = " " DO Texts.Read(R, ch) END ;
- WHILE ch > " " DO
- i.par[k] := ch; INC(k);
- Display.GetChar(i.fnt.raster, ch, dx, d0, d1, d2, d3, d4); INC(o.dx, dx*4);
- Texts.Read(R, ch)
- END ;
- i.par[k] := 0X; o.dy := (i.fnt.height + 4)*4; o.Calc;
- Oberon.GetSelection(T, beg, end, time);
- IF time > 0 THEN
- Texts.OpenScanner(S, T, beg); Texts.Scan(S);
- IF S.class = Texts.Name THEN COPY(S.s, i.cmd) END
- END ;
- KeplerFrames.Focus.Append(o);
- KeplerFrames.Focus.Append(i);
- END
- END NewIcon;
- (* ---------------------------------- Galaxy ---------------------------------- *)
- PROCEDURE (self: Galaxy) Draw* (F: KeplerPorts.Port);
- BEGIN
- INC(F.x0, self.p[0].x); INC(F.y0, self.p[0].y);
- self.G.Draw(F);
- DEC(F.x0, self.p[0].x); DEC(F.y0, self.p[0].y)
- END Draw;
- PROCEDURE *Dummy(op: INTEGER; g: KeplerGraphs.Graph; c: KeplerGraphs.Object);
- END Dummy;
- PROCEDURE (self: Galaxy) Read* (VAR R: Files.Rider);
- VAR o: KeplerGraphs.Object;
- BEGIN
- self.Read^(R);
- KeplerGraphs.ReadObj(R, o); self.G := o(KeplerGraphs.Graph)
- END Read;
- PROCEDURE (self: Galaxy) Write* (VAR R: Files.Rider);
- BEGIN
- self.Write^(R);
- KeplerGraphs.WriteObj(R, self.G)
- END Write;
- PROCEDURE NewGalaxy*;
- VAR G: KeplerGraphs.Graph;
- Gx: Galaxy;
- M: KeplerFrames.SelMsg;
- offset: Kepler2.Offset;
- p0: KeplerGraphs.Star;
- B: KeplerPorts.BalloonPort;
- BEGIN
- M.time := 0;
- Viewers.Broadcast(M);
- IF (M.time > 0) & (KeplerFrames.nofpts > 0) THEN
- KeplerFrames.ConsumePoint(p0);
- NEW(G); G.notify := KeplerFrames.NotifyDisplay;
- G.CopySelection(M.G, 0, 0); G.All(0);
- NEW(B); KeplerPorts.InitBalloon(B);
- G.Draw(B);
- G.All(1); G.MoveSelection(-B.X, -B.Y); G.All(0);
- NEW(offset); NEW(offset.c);
- offset.dx := B.W; offset.dy := B.H;
- offset.c.p[0] := p0; INC(p0.refcnt); offset.refcnt := 1; offset.c.nofpts := 1; offset.Calc;
- NEW(Gx); Gx.G := G; G := KeplerFrames.Focus;
- Gx.p[0] := p0; Gx.p[1] := offset; Gx.nofpts := 2;
- G.Append(p0); G.Append(offset); G.Append(Gx)
- END
- END NewGalaxy;
- (* ---------------------------------- Button ---------------------------------- *)
- PROCEDURE NewButton*;
- VAR o: KeplerFrames.Button; beg, end, time, i: LONGINT; S: Texts.Scanner; T: Texts.Text;
- BEGIN
- IF KeplerFrames.nofpts >= 2 THEN
- Oberon.GetSelection(T, beg, end, time);
- IF time > 0 THEN
- Texts.OpenScanner(S, T, beg);
- Texts.Scan(S);
- IF S.class = Texts.Name THEN
- NEW(o); o.nofpts := 2;
- KeplerFrames.ConsumePoint(o.p[0]);
- KeplerFrames.ConsumePoint(o.p[1]);
- KeplerFrames.Focus.Append(o);
- COPY(S.s, o.cmd); i := 0;
- WHILE Texts.Pos(S) < end DO
- Texts.Read(S, o.par[i]); INC(i)
- END
- END
- END
- END
- END NewButton;
- PROCEDURE UpdateButton*;
- VAR o: KeplerFrames.Button; beg, end, time, i: LONGINT; S: Texts.Scanner; T: Texts.Text;
- BEGIN
- o := KeplerFrames.MarkedButton();
- IF o # NIL THEN
- Oberon.GetSelection(T, beg, end, time);
- IF time > 0 THEN
- Texts.OpenScanner(S, T, beg);
- Texts.Scan(S);
- IF S.class = Texts.Name THEN
- COPY(S.s, o.cmd); i := 0;
- WHILE Texts.Pos(S) < end DO
- Texts.Read(S, o.par[i]); INC(i)
- END
- END
- END
- END
- END UpdateButton;
- END Kepler4.
-